home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Convert_Nu21679411162009.psc / Convert Numbers / Calculations.bas next >
BASIC Source File  |  2009-11-16  |  7KB  |  211 lines
  1. Attribute VB_Name = "Calculations"
  2. Option Explicit
  3.  
  4. Private Function Max(ByVal Num1 As Double, ByVal Num2 As Double) As Double
  5.     Max = (Num1 + Num2) / 2 + (Abs(Num1 - Num2)) / 2
  6. End Function
  7.  
  8. Private Function FillWithZeroes(Number As String, Length As Long) As String
  9.     On Error Resume Next
  10.     FillWithZeroes = String(Length - Len(Number), "0") & Number
  11. End Function
  12.  
  13. Private Function LTrimChar(Number As String, Char As String, Optional ByVal AssumeAsNoneAsChar As Boolean = True) As String
  14.     Dim i As Integer
  15.     For i = 1 To Len(Number)
  16.         If Mid(Number, i, 1) <> Char Then Exit For
  17.     Next
  18.     i = i - 1
  19.     LTrimChar = Right(Number, Len(Number) - i)
  20.     If AssumeAsNoneAsChar = True Then If LTrimChar = "" Then LTrimChar = Char
  21. End Function
  22.  
  23. Private Function MultiplyBy1Digit(Num1 As String, Digit As String) As String ' a * b and b < 10
  24.     Dim i As Integer
  25.     Dim Result As String
  26.     Dim Counter As String
  27.     For i = 1 To (Digit)
  28.         Result = Add(Result, Num1, 2)
  29.     Next
  30.     MultiplyBy1Digit = Result
  31. End Function
  32.  
  33. Public Function Multiply(Num1 As String, Num2 As String) As String
  34.     Dim Numbers() As String
  35.     Dim i As Integer
  36.     Dim Result As String
  37.     Dim Num2Inverted As String
  38.     
  39.     
  40.     ReDim Numbers(1 To Len(Num2)) As String
  41.     
  42.     Num2Inverted = InvertString(Num2)
  43.     For i = 1 To Len(Num2Inverted)
  44.         Numbers(i) = MultiplyBy1Digit(Num1, (Mid(Num2Inverted, i, 1))) & String(i - 1, "0")
  45.     Next
  46.     
  47.     Result = Numbers(1)
  48.     
  49.     If UBound(Numbers) > 1 Then
  50.         For i = 2 To UBound(Numbers)
  51.             Result = Add(Result, Numbers(i), 10)
  52.         Next
  53.     End If
  54.     Multiply = Result
  55. End Function
  56.  
  57. Public Function Power(Num1 As String, Num2 As String) As String ' a ^ b
  58.     Dim i As Double
  59.     Dim Result As String
  60.     Dim Counter As String
  61.     Result = "1"
  62.     For i = 1 To Val(Num2)
  63.         Result = Multiply(Result, Num1)
  64.     Next
  65.     Power = Result
  66. End Function
  67. Private Function InvertString(str As String) As String
  68.     Dim i As Double
  69.     For i = Len(str) To 1 Step -1
  70.         InvertString = InvertString & Mid(str, i, 1)
  71.     Next
  72. End Function
  73.  
  74. Private Function IsValueZero(Number As String) As Boolean
  75.     Dim i As Integer
  76.     IsValueZero = True
  77.     For i = 1 To Len(Number)
  78.         If Mid(Number, i, 1) <> "0" Then
  79.             IsValueZero = False
  80.         End If
  81.     Next
  82. End Function
  83.  
  84. '    Dim TwoDigits As String
  85. '    Dim i As Integer
  86. '    Dim DigitResult As String
  87. '    Dim Result As String
  88. '    Dim DigitRest As String
  89. '
  90. '    TwoDigits = "0" & Mid(Numerator, 1, 1)
  91. '
  92. '    For i = 1 To Len(Numerator)
  93. '        DigitResult = TwoDigits \ Denominator
  94. '        DigitRest = TwoDigits Mod Denominator
  95. '        Result = Result & DigitResult
  96. '        TwoDigits = DigitRest & Mid(Numerator, i + 1, 1)
  97. '    Next
  98. '    DivideNonRestoring = LTrimChar(Result, "0")
  99.  
  100.  
  101. 'summary:
  102. Public Function DivideNonRestoring(Numerator As String, Denominator As String) As String ' a \ b --> int(a / b)
  103.     Dim TwoDigits As String
  104.     Dim i As Integer
  105.     Dim Result As String
  106.     
  107.     TwoDigits = "0" & Mid(Numerator, 1, 1)
  108.     
  109.     For i = 1 To Len(Numerator)
  110.         Result = Result & (TwoDigits \ Denominator)
  111.         TwoDigits = (TwoDigits Mod Denominator) & Mid(Numerator, i + 1, 1)
  112.     Next
  113.     DivideNonRestoring = LTrimChar(Result, "0")
  114. End Function
  115.  
  116.  
  117. '    Dim TwoDigits As String
  118. '    Dim i As Integer
  119. '    Dim DigitResult As String
  120. '    Dim Result As String
  121. '    Dim DigitRest As String
  122. '
  123. '    TwoDigits = "0" & Mid(Numerator, 1, 1)
  124. '
  125. '    For i = 1 To Len(Numerator)
  126. '        DigitResult = TwoDigits \ Denominator
  127. '        DigitRest = TwoDigits Mod Denominator
  128. '        Result = Result & DigitResult
  129. '        TwoDigits = DigitRest & Mid(Numerator, i + 1, 1)
  130. '    Next
  131. '    Modulo = LTrimChar(DigitRest, "0")
  132.  
  133. 'summary:
  134. Public Function Modulo(Numerator As String, Denominator As String) As String ' a mod b
  135.     Dim TwoDigits As String
  136.     Dim i As Integer
  137.     
  138.     TwoDigits = "0" & Mid(Numerator, 1, 1)
  139.     
  140.     For i = 1 To Len(Numerator)
  141.         TwoDigits = (TwoDigits Mod Denominator) & Mid(Numerator, i + 1, 1)
  142.     Next
  143.     Modulo = LTrimChar((TwoDigits Mod Denominator), "0")
  144. End Function
  145.  
  146. Public Function Add(ByVal Num1 As String, ByVal Num2 As String, Optional ByVal GroupNumsLength As Byte = 15) As String ' a + b
  147.     ' a + b
  148.     Dim Group1 As Double, Group2 As Double, GroupResult As Double
  149.     Dim NumZeroes As Integer
  150.     Dim Number1 As String, Number2 As String
  151.     Dim Result As String, CarryNumber As String
  152.     Dim i As Integer, MaxString As Long
  153.         
  154.     NumZeroes = GroupNumsLength - 1
  155.     
  156.     Number1 = FillWithZeroes(Num1, Celling(Len(Num1), GroupNumsLength))
  157.     Number2 = FillWithZeroes(Num2, Celling(Len(Num2), GroupNumsLength))
  158.  
  159.     MaxString = Max(Len(Number1), Len(Number2))
  160.     Number1 = FillWithZeroes(Number1, MaxString)
  161.     Number2 = FillWithZeroes(Number2, MaxString)
  162.         
  163.     For i = 1 To MaxString Step GroupNumsLength
  164.         Group1 = Val(Mid(Number1, i, GroupNumsLength))
  165.         Group2 = Val(Mid(Number2, i, GroupNumsLength))
  166.         GroupResult = Group1 + Group2
  167.         If GroupResult < 10 ^ GroupNumsLength Then
  168.             Result = Result & Format(GroupResult, String(GroupNumsLength, "0"))
  169.             CarryNumber = CarryNumber & "0" & String(NumZeroes, "0")
  170.         ElseIf GroupResult >= 10 ^ GroupNumsLength Then
  171.             Result = Result & Format(GroupResult - (10 ^ GroupNumsLength), String(GroupNumsLength, "0"))
  172.             CarryNumber = CarryNumber & "1" & String(NumZeroes, "0")
  173.         End If
  174.     Next
  175.     
  176.     Do Until IsValueZero(CarryNumber)
  177.     
  178.         CarryNumber = CarryNumber & "0"
  179.         Number1 = Result: Result = ""
  180.         Number2 = CarryNumber: CarryNumber = ""
  181.         
  182.         Number1 = FillWithZeroes(Number1, Celling(Len(Number1), GroupNumsLength))
  183.         Number2 = FillWithZeroes(Number2, Celling(Len(Number2), GroupNumsLength))
  184.     
  185.         MaxString = Max(Len(Number1), Len(Number2))
  186.         Number1 = FillWithZeroes(Number1, MaxString)
  187.         Number2 = FillWithZeroes(Number2, MaxString)
  188.         
  189.         For i = 1 To MaxString Step GroupNumsLength
  190.             Group1 = Val(Mid(Number1, i, GroupNumsLength))
  191.             Group2 = Val(Mid(Number2, i, GroupNumsLength))
  192.             GroupResult = Group1 + Group2
  193.             If GroupResult < 10 ^ GroupNumsLength Then
  194.                 Result = Result & Format(GroupResult, String(GroupNumsLength, "0"))
  195.                 CarryNumber = CarryNumber & "0" & String(NumZeroes, "0")
  196.             ElseIf GroupResult >= 10 ^ GroupNumsLength Then
  197.                 Result = Result & Format(GroupResult - (10 ^ GroupNumsLength), String(GroupNumsLength, "0"))
  198.                 CarryNumber = CarryNumber & "1" & String(NumZeroes, "0")
  199.             End If
  200.         Next
  201.     Loop
  202.     
  203.     Add = LTrimChar(Result, "0")
  204. End Function
  205.  
  206.  
  207. Private Function Celling(ByVal Number As Double, ByVal Steps As Integer) As Double
  208.     Celling = (Int(Number / Steps) * Steps) + (Steps * (Sgn(Number Mod Steps)))
  209. End Function
  210.  
  211.